home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2004 #2 / Amiga Plus CD - 2004 - No. 02.iso / AmigaPlus / Tools / Development / AmigaTalk / general / Object.st < prev    next >
Encoding:
Text File  |  2004-01-31  |  10.2 KB  |  383 lines
  1. "-----------------------------------------------------------------"
  2. " Object Class is the Root of all other Classes in AmigaTalk.     "
  3. " The perform: methods are NOT part of the original Little        "
  4. " Smalltalk code.  They might be moved sometime in the future.    "
  5. "                                                                 "
  6. " HISTORY                                                         "
  7. "    07-Oct-2003 - Added the instVarAt: & instVarAt:put: methods, "
  8. "                  which are only used in the ?? Class.           "
  9. "                                                                 "
  10. "-----------------------------------------------------------------"
  11.  
  12. Class Object
  13. [
  14.    instVarAt: index
  15.  
  16.       " Answer with a fixed variable in an object.  The numbering 
  17.       * of the variables corresponds to the named instance variables.  
  18.       * Fail if the index is not an Integer or is not the index 
  19.       * of a fixed variable.
  20.       "
  21.       ^ <primitive 95 0 index self>
  22. |
  23.    instVarAt: anInteger put: anObject
  24.  
  25.       " Store a value into a fixed variable in the receiver.  
  26.       * The numbering of the variables corresponds to the named 
  27.       * instance variables.  Fail if the index is not an Integer or 
  28.       * is not the index of a fixed variable.
  29.       * Answer with the value stored as the result.  (Using this
  30.       * message violates the principle that each object has 
  31.       * sovereign control over the storing of values into its 
  32.       * instance variables)
  33.       "
  34.       ^ <primitive 95 1 anInteger anObject self>
  35. |
  36.     identityHash                 " Added on 02-Apr-2002 "   
  37.  
  38.       ^ <primitive 5 self>
  39. |       
  40.     == anObject
  41.  
  42.       ^ <primitive 7 self anObject >
  43. |
  44.     ~~ x
  45.  
  46.       ^ (self == x) not
  47. |
  48.     = x
  49.  
  50.       ^ (self == x)              "Is the receiver equal to x??"
  51. |
  52.     ~= x
  53.  
  54.       ^ (self = x) not           "Is the receiver NOT equal to x??"
  55. |
  56.     asString
  57.  
  58.       ^ <primitive 152 (self class)> "Avoid recursion!"
  59.       "^ self class printString" "<<--Infinite recursive method."
  60. |
  61.     asSymbol
  62.  
  63.       ^ self asString asSymbol   "Return the class a Symbol."
  64. |
  65.     yourself                     "Synonym for self."
  66.  
  67.       ^ self
  68. |
  69.     class
  70.  
  71.       ^ <primitive 1 self>
  72. |
  73.     copy
  74.  
  75.       ^ self shallowCopy postCopy
  76. |
  77.     asValue                                      " Added on 07-Oct-2003 "  
  78.  
  79.       " Return a ValueHolder on the receiver: "
  80.  
  81.       ^ ValueHolder with: self
  82. |
  83.     postCopy                                     " Added on 07-Oct-2003 "
  84.       " Finish doing whatever is required, beyond a shallowCopy,
  85.       * to implement 'copy'. Answer the receiver.  This message
  86.       * is only intended to be sent to the newly created instance.
  87.       * Subclasses may add functionality, but they should 
  88.       * always do super postCopy first.
  89.       *
  90.       * Note that any subclass that 'mixes in Modelness' (i.e.,
  91.       * implements dependents with an instance variable) must 
  92.       * include the equivalent of 'self breakDependents' in 
  93.       * its implementation of postCopy. 
  94.       "
  95.       ^ self
  96. |
  97.     deepCopy  ! size newobj !
  98.  
  99.       size <- <primitive 4 self>.
  100.  
  101.       ((size bitAnd: 16r0F000000) ~= 0) 
  102.           ifTrue: [^ self]                    "if built-in, just return self"
  103.  
  104.          ifFalse: [ newobj <- self class new.
  105.  
  106.                     1 to: size
  107.                       do: [ :idx !
  108.                             <primitive 112 newobj idx (<primitive 111 self idx> copy)> ].
  109.  
  110.                     ^ newobj ]
  111. |
  112.     first
  113.  
  114.       ^ self
  115. |
  116.     do: aBlock     ! item !
  117.       
  118.       item <- self first.
  119.  
  120.       ^ [item notNil] 
  121.           whileTrue: [ aBlock value: item.  
  122.                        item <- self next
  123.                      ]
  124. |
  125.     do: aBlock without: anObject ! item !  "Added on 20-Jun-2001 (JTS)"
  126.  
  127.       (anObject == nil)
  128.          ifFalse: [ item <- self first.
  129.  
  130.                     ^ [item notNil] 
  131.                         whileTrue: [ (item ~~ anObject) 
  132.                                        ifTrue: [aBlock value: item].
  133.                        
  134.                                      item <- self next 
  135.                                    ]
  136.                   ]
  137.                   
  138.           ifTrue: [ self do: aBlock ]
  139. |
  140.     error: aString
  141.  
  142.       <primitive 122 aString self>
  143. |
  144.     isKindOf: aClass ! objectClass !
  145.  
  146.       objectClass <- self class.
  147.  
  148.       [objectClass notNil] whileTrue:
  149.              [(objectClass == aClass) ifTrue: [^ true].
  150.  
  151.                  objectClass <- objectClass superClass].
  152.       ^ false
  153. |
  154.     isMemberOf: aClass
  155.     
  156.        ^ (aClass == self class)
  157. |
  158.     ifKindOf: aClass thenDo: aBlock
  159.  
  160.        ^ (self isKindOf: aClass) 
  161.             ifTrue: [aBlock value: self]
  162. |
  163.     isNil
  164.  
  165.        ^ false
  166. |
  167.     ifNil: nilBlock
  168.  
  169.        ^ self       " only nil will evaluate nilBlock "
  170. |
  171.     next
  172.  
  173.        ^ nil
  174. |
  175.     notNil
  176.  
  177.        ^ true
  178. |
  179.     print
  180.  
  181.        <primitive 121 (self printString)>
  182. |
  183.     printNoReturn
  184.  
  185.        <primitive 120 (self printString)>
  186. |
  187.     printString
  188.  
  189.        ^ self asString
  190. |    
  191.     respondsTo: cmd
  192.  
  193.        ^ self class respondsTo: cmd
  194. |    
  195.     shallowCopy ! size newobj !
  196.  
  197.        size <- <primitive 4 self>.
  198.  
  199.        ((size bitAnd: 16r0F000000) ~= 0) 
  200.           ifTrue: [^ self]                    "if built-in, just return self"
  201.  
  202.          ifFalse: [ newobj <- self class new.
  203.  
  204.                     1 to: size
  205.                       do: [ :i ! <primitive 112 newobj i <primitive 111 self i > > ].
  206.  
  207.                     ^ newobj ]
  208. |
  209.    asciiToString: aNumber ! masked !
  210.  
  211.       " Convert aNumber into a single-character String: "
  212.  
  213.       masked <- <primitive 23 aNumber 16rFF>.
  214.       
  215.       ^ <primitive 96 masked> 
  216. |
  217.    subclassResponsibility: methodString ! msg !
  218.  
  219.      msg <- String new: 'Method ',methodString,' should be implemented in a SubClass!'.
  220.  
  221.      ^ <primitive 181 13 msg 'User ERROR:' 'OKAY'>
  222. |
  223.    notImplemented: methodString ! msg ! 
  224.  
  225.      msg <- String new: 'Method ',methodString,' NOT implemented!'.
  226.  
  227.      ^ <primitive 181 13 msg 'User ERROR:' 'OKAY'>
  228. |
  229.    doesNotUnderstand: methodString ! msg !
  230.  
  231.      msg <- String new: 'Method ',methodString,' NOT understood!'.
  232.  
  233.      ^ <primitive 181 13 msg 'User ERROR:' 'OKAY'> 
  234. |
  235.    shouldNotImplement: methodString ! msg !
  236.  
  237.      msg <- String new: 'Method ',methodString,' should NOT BE implemented!'.
  238.  
  239.      ^ <primitive 181 13 msg 'User ERROR:' 'OKAY'>
  240. |
  241.    notYetImplemented
  242.  
  243.      ^ <primitive 181 13 'NOT yet implemented!' 'User ERROR:' 'OKAY'>
  244. |
  245.    perform: selector  ! argArray ! 
  246.    
  247.       " Send the unary selector to the receiver: "
  248.  
  249.       (selector isMemberOf: Symbol)
  250.          ifFalse: [^ self error: 'Selector argument must be a Symbol!'].
  251.  
  252.       (self respondsTo: selector)
  253.          ifFalse: [^ self error: 'Does NOT respondTo:  ', selector ].
  254.  
  255.       argArray <- Array new: 1.
  256.  
  257.       argArray at: 1 put: self.
  258.       
  259.       ^ <primitive 143 argArray selector>
  260. |
  261.    perform: selector orSendTo: otherTarget
  262.    
  263.       " If I wish to intercept and handle selector myself, 
  264.       * do it; else send it to otherTarget
  265.       "
  266.       ^ otherTarget perform: selector
  267. |
  268.    perform: selector with: anObject  ! argArray !
  269.       
  270.       " Send the selector, aSymbol, to the receiver with 
  271.       * anObject as its argument:
  272.       "
  273.       (selector isMemberOf: Symbol)
  274.          ifFalse: [^ self error: 'Selector argument must be a Symbol!'].
  275.  
  276.       (self respondsTo: selector)
  277.          ifFalse: [^ self error: 'Does NOT respondTo:  ', selector ].
  278.  
  279.       argArray <- Array new: 2.
  280.       
  281.       argArray at: 1 put: self.
  282.       argArray at: 2 put: anObject.
  283.       
  284.       ^ <primitive 143 argArray selector>
  285. |
  286.    perform: selector withArguments: argArray ! lsArray !
  287.       
  288.       " Send the selector, aSymbol, to the receiver with 
  289.       * arguments in argArray.  Fail if the number of 
  290.       * arguments expected by the selector does not match 
  291.       * the size of lsArray:
  292.       "
  293.       (argArray size = 0)
  294.          ifTrue: [ ^ self perform: selector ]. " Short-circuit stupid User "
  295.  
  296.       (argArray size = 1)  " Short-circuit stupid User: "
  297.          ifTrue: [ ^ self perform: selector with: (argArray at: 1) ].
  298.          
  299.       " Go the long way around: "
  300.  
  301.       lsArray <- Array new: ((argArray size) + 1).
  302.  
  303.       (selector isMemberOf: Symbol)
  304.          ifFalse: [^ self error: 'Selector argument must be a Symbol!'].
  305.  
  306.       (selector numArgs = argArray size)
  307.          ifFalse: [^ self error: 'Incorrect number of arguments!'].
  308.         
  309.       (self respondsTo: selector)
  310.          ifFalse: [^ self error: 'Does NOT respondTo:  ', selector ].
  311.  
  312.       lsArray at: 1 put: self.
  313.       
  314.       (2 to: lsArray size)
  315.          do: [:ele ! lsArray at: ele put: (argArray at: (ele - 1))].
  316.       
  317.       ^ <primitive 143 lsArray selector>
  318. |
  319.    perform: selector with: firstObject with: secondObject ! argArray ! 
  320.  
  321.       " Send the selector, aSymbol, to the receiver with the 
  322.       * given arguments.
  323.       "
  324.       selector isMemberOf: Symbol
  325.          ifFalse: [^ self error: 'Selector argument must be a Symbol!'].
  326.  
  327.       (self respondsTo: selector)
  328.          ifFalse: [^ self error: 'Does NOT respondTo:  ', selector ].
  329.  
  330.       argArray <- Array new: 3.
  331.    
  332.       argArray at: 1 put: self.
  333.       argArray at: 2 put: firstObject.
  334.       argArray at: 3 put: secondObject.
  335.  
  336.       ^ <primitive 143 argArray selector>
  337. |
  338.    perform: selector with: firstObject with: secondObject with: thirdObject ! argArray !
  339.    
  340.       " Send the selector, aSymbol, to the receiver with the given arguments: "
  341.  
  342.       (selector isMemberOf: Symbol)
  343.          ifFalse: [^ self error: 'Selector argument must be a Symbol!'].
  344.  
  345.       (self respondsTo: selector)
  346.          ifFalse: [^ self error: 'Does NOT respondTo:  ', selector ].
  347.  
  348.       argArray <- Array new: 4.
  349.  
  350.       argArray at: 1 put: self.
  351.       argArray at: 2 put: firstObject.
  352.       argArray at: 3 put: secondObject.
  353.       argArray at: 4 put: thirdObject.
  354.       
  355.       ^ <primitive 143 argArray selector>
  356. |
  357.    performUpdate: aSymbol with: anObject
  358.  
  359.       self perform: aSymbol with: anObject
  360. |
  361.    performUpdate: aSymbol
  362.  
  363.       self perform: aSymbol
  364. |
  365.    breakPoint: msgString
  366.  
  367.       ^ <primitive 209 10 0 msgString>
  368. |
  369.    xxxReport
  370.  
  371.       " Users do NOT need to use this method.  It is for use by 
  372.       * the Author of AmigaTalk for debugging the AmigaTalk System
  373.       "   
  374.       ^ <primitive 250 5 1 self>
  375. |
  376.    xxxAddress: object
  377.  
  378.       " Users do NOT need to use this method.  It is for use by 
  379.       * the Author of AmigaTalk for debugging the AmigaTalk System
  380.       "   
  381.       ^ <primitive 250 5 2 object>
  382. ]
  383.